 unit MyUnit;
 interface
 uses crt;
 const
  NumberSluSlov = 51;
  NumberRazdel = 16;
 type
  mass = array [1..NumberSluSlov] of string[15];
  mass1= array [1..NumberRazdel] of char;
 const
{                       1       2       3       4       5     6      7   }
  SluSlova: mass = ('PROGRAM','USES','LABEL','CONST','TYPE','VAR','CHAR',
{   8        9       10     11       12       13        14      15       }
  'BYTE','INTEGER','WORD','REAL','LONGINT','SHORTINT','LENGTH','DEL',
{    16    17     18     19       20       21         22             }
  'INS','COPY','SET','ARRAY','STRING','BOOLEAN','PROCEDURE',
{    23        24     25     26   27    28      29   30    31     32     }
  'FUNCTION','BEGIN','END','FOR','TO','DOWNTO','DO','IF','THEN','ELSE'
{    33    34    35        36      37     38      39      40       41    }
  ,'CASE','OF','WHILE','REPEAT','UNTIL','WITH','WRITE','WRITELN','READ',
{    42      43    44    45    46    47     48     49    50     51         }
  'READLN','INC','DEC','ORD','CHR','SUCC','PRED','DIV','PRESS','CLEAR');

                 {  1        2          3        4         5         6}
  Razdel : mass1 =('<'  ,   '>'   ,   '='   ,   '*'   ,   '/'   ,   '+',
{     7         8         9         10       11        12         13  }
     '-'   ,   ','   ,   '.'   ,   '('   ,   ')'   ,   ';'   ,   ':'   ,
{     14        15       16}
     '^'   ,   '['   ,   ']' );
  Klassi = ['S','I','R','L','H'];
  {S - служебн слова}
  {I - identificator}
  {L - literal}
  {H - число}
  {R - разделитель}
  {дополнительные функции: LENGTH,COPY,DEL,INS }
  Chi = ['1','2','3','4','5','6','7','8','9','0'];
 type
  Stack = record
             Name :string[20];
             Tip  :string[20];
             TipLo:string[20];
             Razm : word;
             Init : word;
            end;
  massa = array[1..100] of Stack;
  PStackDat=^StackDat;
  StackDat = record
             Name :string;
             Link :PStackDat;
            end;
  TSluSlo = object
             PointerInSluSlova:integer;{текущ номер в таблице}
             BukvaKlassa:string[2];
             procedure Init;
             procedure ObrabSluSlo;
             procedure Searc;
            end;
  TID     = object
             FlagStackOpen:boolean; {открыт ли данн файл}
             PointerInStack:integer;{текущ номер в stacke}
             BukvaKlassa:string[2];
             PointPresElem:integer;
             StackDat,PointerStackDat,PNextStackDat:PStackDat;
             procedure Init;
             procedure Obrab;
             procedure Searc(WhereStackWrite:byte);
             procedure SearcElem(Number:byte;var data:string);
            end;
  TChisla = object(TID)
             procedure  Init;
             procedure RaspoznChis;
            end;
  TLiter  = object(TID)
             procedure Init;
             procedure RaspoznLiter;
            end;
  TRazd   = object
             BukvaKlassa:string[2];
             PointerInRazd:integer;
             procedure Init;
             procedure RaspoznRazd;
             procedure ObrabRazd;
             procedure Searc;
            end;

 var
  SluSlo:TSluSlo;
  Chisla:TChisla;
  ID:TID;
  Razd:TRazd;
  Literal:TLiter;
  Var_File,FileEnd,Fil,Fille: text;
  FlagFileEndOpen:boolean;
  WorkString,BuffString,HelpStr:string;
  i:integer;
  WhereToWrite:byte;     {в какой из файлов писать}
  FileErrorOpen:boolean;
  NumberOfWorkStr:integer;{при лекс анализе как слежение за ошибками}
  Ukaz:word; {указатель на очередной обрабатываемый класс I,R,S,...}
  ReadNot:boolean;{для процедуры резак}
  PamGlo:char;{запоминает прочитанный символ }
  TablS:massa;
  UkToT,UkToT1:word; {указатель на эл кот будет заполняться}
  SchechikStrok:word;
  OtklDuplId:boolean;{откл-е проверки на повтор идент-ров =truе - до begin}
  {                =false-после    }
  stro:string; {для процедуры резак}
  MetkaIf,MetkaFor,MetkaRead:integer;
  MetDel,MetToDec,MetkaF,MetkaDel,MetkaCopy,MetkaInsert:integer;
  Tipi,TipiLo:string;{соделжит "integer","byte",...}
  BufArr:array[1..100] of string[10];
  KolRekurs:integer; {использ-ся в F для подсчета рекурсивных вызовов E}
  KolRekursF:integer; {использ-ся в F ... F при обработке LENGTH}
  FlagObrLength:boolean;
  FlagObrE:boolean;
  DoCallDel,DoCallCopy,DoCallIns,DoCallClear:boolean;{если в проге встретилось Del то true}
  DoCallPress:boolean;
  Vozvr:boolean;
  IIFF:boolean;
  procedure Errora(gg:byte);
  procedure Rezak(var Uk:word;var st:string;var RN:boolean;var filtext:text);
  procedure TabSimb;
  procedure Initial;
  procedure LexicAnalis;
  procedure DisposeStack(Ukazatel:PStackDat);
  procedure GenerDel;
  procedure GenerCopy;
  procedure GenerIns;
  procedure GenerPress;
  procedure GenerClear;
 implementation
 procedure GenerDel;
  begin
   {в ах - с какого элемента в сх - сколько в bx - где}
   writeln(Fille,'$Del    proc     near');
   writeln(Fille,#9,#9,'xor     dx,dx');
   writeln(Fille,#9,#9,'mov     dl,byte ptr [bx]      ;помещаем исходный размер');
   writeln(Fille,#9,#9,'sub     dx,cx        ;получаем новый размер');
   writeln(Fille,#9,#9,'mov     [bx],dl      ;помещаем в 1-й байт');
   writeln(Fille,#9,#9,'add     bx,ax        ;указ на 1-й удал-мый символ');
   writeln(Fille,#9,#9,'push    bx');
   writeln(Fille,#9,#9,'add     bx,cx        ');
   writeln(Fille,#9,#9,'mov     si,bx        ;указ на 1-й символ кот переписывать');
   writeln(Fille,#9,#9,'pop     di        ;куда писать  ');
   writeln(Fille,#9,#9,'mov     cx,dx     ;сколько переписывать');
   writeln(Fille,#9,#9,'add     cx,1      ; $ тоже прихватим');
   writeln(Fille,#9,#9,'rep     movsb     ;');
   writeln(Fille,#9,#9,'ret');
   writeln(Fille,'$Del    endp');
  end;
 procedure GenerCOPY;
  begin
   {в ах - с какого элемента в сх - сколько в di - куда в si - откуда}
   writeln(Fille,'$Copy    proc    near');
   writeln(Fille,#9,#9,'mov     [di],cl      ;помещаем в 1-й байт');
   writeln(Fille,#9,#9,'inc     di           ;пишем со 2-го байта');
   writeln(Fille,#9,#9,'add     si,ax        ;откуда писать  ');
   writeln(Fille,#9,#9,'rep     movsb     ;');
   writeln(Fille,#9,#9,'mov     [di],byte ptr ',#39,'$',#39);
   writeln(Fille,#9,#9,'ret');
   writeln(Fille,'$Copy    endp');
  end;

 procedure GenerIns;
  begin
   {в ах - с какого элемента в di - куда в si - что}
   writeln(Fille,'$Ins    proc    near');
   writeln(Fille,#9,#9,'push    di');
   writeln(Fille,#9,#9,'push    bx       ;новый размер');
   writeln(Fille,#9,#9,'push    di');
   writeln(Fille,#9,#9,'push    si');

   writeln(Fille,#9,#9,'mov     cx,0');
   writeln(Fille,#9,#9,'mov     cl,[di]    ; размер строки ');
   writeln(Fille,#9,#9,'sub     cx,ax      ;на сколько сдвинуть');
   writeln(Fille,#9,#9,'add     cx,1');

   writeln(Fille,#9,#9,'xor     bx,bx');
   writeln(Fille,#9,#9,'mov     bl,byte ptr [si]');

   writeln(Fille,#9,#9,'mov     si,di    ;si на куда');
   writeln(Fille,#9,#9,'add     si,ax    ;с какого эл смещать');
   writeln(Fille,#9,#9,'add     si,cx');
   writeln(Fille,#9,#9,'sub     si,1');
   writeln(Fille,#9,#9,'xor     dx,dx');
   writeln(Fille,#9,#9,'mov     dl,byte ptr [di]');


   writeln(Fille,#9,#9,'add     di,dx');
   writeln(Fille,#9,#9,'add     di,bx   ;адрес переписи');


   writeln(Fille,#9,#9,'std');
   writeln(Fille,#9,#9,'rep     movsb     ;');
   writeln(Fille,#9,#9,'pop     si');

   writeln(Fille,#9,#9,'pop     di');
   writeln(Fille,#9,#9,'add     di,ax');
   writeln(Fille,#9,#9,'cld');
   writeln(Fille,#9,#9,'xor     cx,cx');
   writeln(Fille,#9,#9,'mov     cl,[si]    ;байт размера не пишем');
   writeln(Fille,#9,#9,'add     si,1    ;байт размера не пишем');
   writeln(Fille,#9,#9,'rep     movsb     ;');
   writeln(Fille,#9,#9,'pop     bx         ;новый размер');
   writeln(Fille,#9,#9,'pop     di');
   writeln(Fille,#9,#9,'mov     byte ptr [di],bl  ;новый размер');
   writeln(Fille,#9,#9,'add     di,bx ;+длина строки(чистая)');
   writeln(Fille,#9,#9,'mov     [di+1],byte ptr ',#39,'$',#39);
   writeln(Fille,#9,#9,'ret');
   writeln(Fille,'$Ins    endp');
  end;
 procedure GenerClear;
  begin
   writeln(Fille,'$Clear    proc    near');
   writeln(Fille,#9,#9'push     cx');
   writeln(Fille,#9,#9,'add      [@@SchPu],1');
   writeln(Fille,#9,#9'mov     ax,0600h         ;06 - прокр 00 - весь экр');
   writeln(Fille,#9,#9'mov     bh,07h');
   writeln(Fille,#9,#9'mov     cx,0000h         ;верхний левый');
   writeln(Fille,#9,#9'mov     dx,184Fh         ;нижний правый');
   writeln(Fille,#9,#9'int     10h');
   writeln(Fille,#9,#9'mov     ah,02h           ;установка курсора');
   writeln(Fille,#9,#9'mov     bh,00h           ;экран');
   writeln(Fille,#9,#9'mov     dx,00h           ;dh=str');
   writeln(Fille,#9,#9'int     10h');

   writeln(Fille,#9,#9,'sub      [@@SchPu],1');
   writeln(Fille,#9,#9'pop     cx');
   writeln(Fille,#9,#9,'ret');
   writeln(Fille,'$Clear   endp');
  end;

 procedure GenerPress;
  begin
   writeln(Fille,'$Press    proc    near');
   writeln(Fille,#9,#9'mov	ah,01h		;функция чтения с клавиатуры и эхо');
   writeln(Fille,#9,#9'int	21h		;передача управления в BIOS');


   writeln(Fille,#9,#9,'ret');
   writeln(Fille,'$Press   endp');
  end;

 procedure Errora(gg:byte);
  begin
   case gg of
    1: writeln('Ошибка 1  ! Неверный тип ! ',SchechikStrok);
    2: writeln('Ошибка 2  ! PROGRAM отсутствует ! ',SchechikStrok);
    3: writeln('Ошибка 3  ! Неверный разделитель ! ',SchechikStrok);
    4: writeln('Ошибка 4  ! Отсутствует разделитель ! ',SchechikStrok);
    5: writeln('Ошибка 5  ! Имя программы неверно ! ',SchechikStrok);
    6: writeln('Ошибка 6  ! Объявление переменных отсутствует ! ',SchechikStrok);{var отсутствует}
    7: writeln('Ошибка 7  ! Раздел переменных отсутствует ! ',SchechikStrok);
    8: writeln('Ошибка 8  ! Отсутствует идентификатор ! ',SchechikStrok);
    9: writeln('Ошибка 9  ! Незакрытый литерал ! ',NumberOfWorkStr);     {    на    }
   10: writeln('Ошибка 10 ! Слишком длинное имя ! ',NumberOfWorkStr);    {  этапе   }
   11: writeln('Ошибка 11 ! Незакрытый комментарий ! ',NumberOfWorkStr); {  лексич  }
   12: writeln('Ошибка 12 ! Недопустимый символ ! ',NumberOfWorkStr);    { анализа  }
   13: writeln('Ошибка 13 ! Ошибка открытия файла ! ');
   14: writeln('Ошибка 14 ! Повторный идентификатор ! ',NumberOfWorkStr);
   15: writeln('Ошибка 15 ! Неизвестный идентификатор ! ',NumberOfWorkStr);
   16: writeln('Ошибка 16 ! Это же имя программы ! ',SchechikStrok);
   17: writeln('Ошибка 17 ! Присутствует разделитель ! ',SchechikStrok);
   18: writeln('Ошибка 18 ! ":=" отсутствует ! ',SchechikStrok);
   19: writeln('Ошибка 19 ! Неверный синтаксис ! ',SchechikStrok);
   20: writeln('Ошибка 20 ! Неверное выражение ! ',SchechikStrok);
   21: writeln('Ошибка 21 ! THEN отсутствует ! ',SchechikStrok);
   22: writeln('Ошибка 22 ! Отсутствует идентификатор или служебное слово! ',SchechikStrok);
   23: writeln('Ошибка 23 ! BEGIN отсутствует ! ',SchechikStrok);
   24: writeln('Ошибка 24 ! END отсутствует ! ',SchechikStrok);
   25: writeln('Ошибка 25 ! Конец файла отсутствует ! ');
   26: writeln('Ошибка 26 ! ";" отсутствует ! ',SchechikStrok);
   27: writeln('Ошибка 27 ! Переменная цикла отсутствует ! ',SchechikStrok);
   28: writeln('Ошибка 28 ! TO отсутствует ! ',SchechikStrok);
   29: writeln('Ошибка 29 ! Ограничение отсутствует ! ',SchechikStrok);
   30: writeln('Ошибка 30 ! DO отсутствует ! ',SchechikStrok);
   31: writeln('Ошибка 31 ! Отсутствует идентификатор, литерал или служебное слово! ',SchechikStrok);
   32: writeln('Ошибка 32 ! "(" отсутствует ! ',SchechikStrok);
   33: writeln('Ошибка 33 ! ")" отсутствует ! ',SchechikStrok);
   34: writeln('Ошибка 34 ! Несоответствие типов ! ',SchechikStrok);
   35: writeln('Ошибка 35 ! "[" отсутствует ! ',SchechikStrok);
   36: writeln('Ошибка 36 ! "]" отсутствует ! ',SchechikStrok);
   37: writeln('Ошибка 37 ! Отсутствует идентификатор типа STRING! ',SchechikStrok);
   38: writeln('Ошибка 38 ! Индекс должен быть INTEGER or BYTE ! ',SchechikStrok);
   39: writeln('Ошибка 39 ! Параметр LENGTH - идентификатор типа STRING! ',SchechikStrok);
   40: writeln('Ошибка 40 ! "," oтсутствует ! ',SchechikStrok);
   end;
   readkey;
   Halt(1);
  end;
 procedure PrntTablS;
  begin
   writeln;
   writeln('ТАБЛИЦА СИМВОЛОВ':40);
   writeln;
   writeln('       имя          тип         тип локал     размер',
              '        значение');
   for i:=1 to UkToT do
    begin
     write(TablS[i].Name:10);
     write(TablS[i].Tip:15);
     write(TablS[i].TipLo:15);
     write(TablS[i].Razm:10);
     write(TablS[i].Init:15);
     writeln;
    end;
  end;
 procedure Rezak(var Uk:word;var st:string;var RN:boolean;var filtext:text);
  var
   flag:boolean;
   Buf:char;
  begin
   st:='';
     if not RN then read(Filtext,Buf) else Buf:=PamGlo;
     while buf='#' do
      begin
       inc(SchechikStrok);
       inc(Uk);
       read(Filtext,Buf);
      end;
     if Buf in Klassi then
      begin
       st:=st+Buf;   {+буква}
       read(Filtext,Buf);
       if Buf in Chi then
        begin
         st:=st+Buf;    {+число}
         read(Filtext,Buf);
         if Buf in Chi then
          begin
           RN:=false;
           st:=st+Buf;      {+число}
           Uk:=Uk+3;
          end
         else
          begin
           RN:=true;
           PamGlo:=Buf; {запоминаем букву на кот переместились}
           Uk:=Uk+2;
          end;
        end;
      end;
  end;
 procedure ZapisN(BK:char;Schet:word);
  var
   ii:integer;
  begin
   case Bk of
    'S': TablS[UkToT].Name:=SluSlova[Schet];
    'I':  with ID do
           begin
            if Schet = 1 then TablS[UkToT].Name:=StackDat^.Name
            else
             begin
              PNextStackDat:=StackDat;
              for ii:=1 to Schet-1 do
                PNextStackDat:=PNextStackDat^.Link;
              TablS[UkToT].Name:=PNextStackDat^.Name;
             end;
           end;
   end;
  end;
 procedure ZapisRazm(Schet:word;UTT:integer);
  var
   ii:integer;
  begin
   with TablS[UTT] do
   case Schet of
    7  : Razm:=1;{char}
    8  : Razm:=1;{byte}
    9  : Razm:=2;{integer}
    10 : Razm:=2;{word}
    20 : Razm:=256; {string}
   end;
  end;
 procedure TabSimb;
  var
   Simbl:char;
   BukCla:char;
   sch,cod,KolvoEl,ii:integer;
   Rememba:string;
   NumbNotInitZapis,cicl,cicl1:integer;
   FlagNumbNotInitZapis,fl:boolean;
  begin
   NumbNotInitZapis:=1;
   FlagNumbNotInitZapis:=false;
   Rezak(Ukaz,stro,ReadNot,Fil);
   if stro<>'S1'{program} then Errora(2);
   Rezak(Ukaz,stro,ReadNot,Fil);
   if stro[1]<>'I' then Errora(5);
   Rezak(Ukaz,stro,ReadNot,Fil);
   if stro<>'R12'{;}then
    if stro='S6'then Errora(4) else Errora(3);
   Rezak(Ukaz,stro,ReadNot,Fil);
   if stro<>'S24'{<>begin}then
   if stro<>'S6'{<>var} then
    begin
     Rezak(Ukaz,stro,ReadNot,Fil);
     if stro<>'S24'{<>begin}then Errora(6);
    end;
   if stro<>'S24'{<>begin}then
{-------------------------------------------------}
   begin
   Rezak(Ukaz,stro,ReadNot,Fil);
   if stro[1]<>'I' then Errora(8);
   while (not eof(Fil)) and (stro<>'S24'){begin} do
    begin
     inc(UkToT);
     BukCla:=stro[1];
     Delete(stro,1,1);
     val(stro,sch,cod);{sch - для поиска по данным}
     ZapisN(BukCla,sch);  {запись имени в табл симв}
     Rezak(Ukaz,stro,ReadNot,Fil);
     if stro = 'R13'{:} then
      begin
       Rezak(Ukaz,stro,ReadNot,Fil);
       if (stro <> 'S19'){<>array}and (stro[1]='S')then
        begin
         Delete(stro,1,1);
         val(stro,sch,cod);{sch - для поиска по данным}
         TablS[UkToT].Tip:=SluSlova[sch]; {в поле тип}
         ZapisRazm(sch,UkToT);  {размер}
         TablS[UkToT].Init:=0; {в поле нач знач}
         if FlagNumbNotInitZapis then
          begin
           for cicl:=NumbNotInitZapis to UkToT-1 do
            begin
             TablS[cicl].Tip:=SluSlova[sch]; {в поле тип}
             ZapisRazm(sch,cicl);  {размер}
             TablS[cicl].Init:=0; {в поле нач знач}
            end;
           FlagNumbNotInitZapis:=false;{обработка => типа}
          end;
         Rezak(Ukaz,stro,ReadNot,Fil);
         if stro <> 'R12'{;} then Errora(4);        end
        else
        if (stro = 'S19'){array} then
        begin
         Rezak(Ukaz,stro,ReadNot,Fil);
         if stro = 'R15'{[} then
          begin
           Rezak(Ukaz,stro,ReadNot,Fil);
           BukCla:=stro[1];
           Delete(stro,1,1);
           val(stro,sch,cod);{sch - для поиска по данным}
           Chisla.SearcElem(sch,Rememba); {в rememba - нужное число возвращает}
           val (Rememba,KolvoEl,cod);{KolvoEl - кол-во эл-тов массива}
           Rezak(Ukaz,stro,ReadNot,Fil);
           if stro = 'R16'{]} then
            begin
             Rezak(Ukaz,stro,ReadNot,Fil);
             if stro = 'S34'{of} then
              begin
               Rezak(Ukaz,stro,ReadNot,Fil);
               if stro[1] = 'S' then
                begin
                 Delete(stro,1,1); {убираем S, оставляя номер}
                 val(stro,sch,cod);{sch - для поиска по данным}
                 if sch in [7,8,9,10,11,12,13,16,20,21] then
                  begin
                   TablS[UkToT].Tip:='@@arr@@'; {последнего}
                   TablS[UkToT].TipLo:=SluSlova[sch];
                   ZapisRazm(sch,UkToT);
                   TablS[UkToT].Init:=KolvoEl;
                   if FlagNumbNotInitZapis then {если есть не инициал записи}
                    begin
                     for cicl:=NumbNotInitZapis to UkToT-1 do
                      begin                        {заполняем все кроме}
                       TablS[cicl].Tip:='@@arr@@'; {последнего}
                       TablS[cicl].TipLo:=SluSlova[sch];
                       ZapisRazm(sch,cicl);
                       TablS[cicl].Init:=KolvoEl
                      end;
                     FlagNumbNotInitZapis:=false;{обработка => типа}
                    end;
                  end
                  else
                  Errora(1);
                end
               else Errora(1);
              end
              else
              Errora(2);
            end
            else
            if stro[1]='R' then Errora(3) else Errora(4);
          end
         else
         if stro[1]='R' then Errora(3) else Errora(4);
         Rezak(Ukaz,stro,ReadNot,Fil);
         if stro <>'R12'{;} then Errora(4);
        end
        else
        Errora(1);
      end
     else
      begin
       if (stro<>'R8'){,} then if (stro[1]='R') then Errora(3) else Errora(4);
       if not FlagNumbNotInitZapis then
        begin
         FlagNumbNotInitZapis:=true; {пока не дойдем до типа- - UkToT помним}
         NumbNotInitZapis:=UkToT;
        end;
      end;
     Rezak(Ukaz,stro,ReadNot,Fil);
    end;
   { PrntTablS;}
   end
   else writeln('Блок данных отсутствует !!');
   {при выходе имеем указатель на => элемент после begin}
  end;
 procedure PrntStks;
  var
   k:integer;
   filll:text;
   j:integer;
  begin
   k:=0;
    with ID do
    if FlagStackOpen then
     begin
     {$I-}
     Assign(Filll,'1_iden.txt');
     Rewrite(Filll);
     if IOResult<>0 then Errora(13);
     {$I+}
     PNextStackDat:=StackDat;
     While PNextStackDat<>nil do
      begin
       inc(k);
       Str(k,HelpStr);
       for j:=1 to 8-length(HelpStr) do
        HelpStr:=HelpStr+' ';
       HelpStr:=HelpStr+PNextStackDat^.Name;
       PNextStackDat:=PNextStackDat^.Link;
       Writeln(filll,HelpStr);
      end;
     close(Filll);
     {$I-}
    k:=0;
    end;
    with Chisla do
    if FlagStackOpen then
     begin
     {$I-}
     Assign(Filll,'2_chisla.txt');
     Rewrite(Filll);
     if IOResult<>0 then Errora(13);
     {$I+}
     PNextStackDat:=StackDat;
     While PNextStackDat<>nil do
      begin
       inc(k);
       Str(k,HelpStr);
       for j:=1 to 8-length(HelpStr) do
        HelpStr:=HelpStr+' ';
       HelpStr:=HelpStr+PNextStackDat^.Name;
       PNextStackDat:=PNextStackDat^.Link;
       Writeln(filll,HelpStr);
      end;
     close(Filll);
     {$I-}
     end;
    k:=0;
    with Literal do
    if FlagStackOpen then
{----------------------------}
     begin
     {$I-}
     Assign(Filll,'3_liter.txt');
     Rewrite(Filll);
     if IOResult<>0 then Errora(13);
     {$I+}
     PNextStackDat:=StackDat;
     While PNextStackDat<>nil do
      begin
       inc(k);
       Str(k,HelpStr);
       for j:=1 to 8-length(HelpStr) do
        HelpStr:=HelpStr+' ';
       HelpStr:=HelpStr+PNextStackDat^.Name;
       PNextStackDat:=PNextStackDat^.Link;
       Writeln(filll,HelpStr);
      end;
     close(Filll);
     {$I-}
     end;
{----------------------}
  end;
 procedure DisposeStack(Ukazatel:PStackDat);
  var
   PPPointer:pointer;
  begin
   while Ukazatel<>nil do
    begin
     PPPointer:=Ukazatel^.Link;
     Dispose(Ukazatel);
     Ukazatel:=PPPointer;
    end;
  end;
 procedure WriteToEndFile(BukvaKlassa:string);
  begin
   {$I-}
   if FlagFileEndOpen = false then
    begin
     Assign(FileEnd,'String.txt'{WorkString});
     Rewrite(FileEnd);
     FlagFileEndOpen:=true;
    end else Append(FileEnd);
   if IOResult<>0 then Errora(13) else Write(FileEnd,BukvaKlassa);
   close(FileEnd);
   {$I+}
  end;
 procedure TSluSlo.Init;
  begin
   PointerInSluSlova:=0; BukvaKlassa:='S';
  end;
 procedure TID.Init;
  begin
   FlagStackOpen:=false; PointerInStack:=0;
   PointPresElem:=0; BukvaKlassa:='I';
  end;
 procedure TChisla.Init;
  begin
   FlagStackOpen:=false; PointerInStack:=0;
   PointPresElem:=0; BukvaKlassa:='H';
  end;
 procedure TLiter.Init;
  begin
   FlagStackOpen:=false; PointerInStack:=0;
   PointPresElem:=0; BukvaKlassa:='L';
  end;
 procedure TRazd.Init;
  begin
   PointerInRazd:=0; BukvaKlassa:='R';
  end;
 procedure TSluSLo.ObrabSluSlo;
  var
   StringDigit,strochka:string;
  begin
   strochka:='';
   str(PointerInSluSlova,StringDigit);
   strochka:=strochka+BukvaKlassa+StringDigit;
   if strochka='S24' then
   OtklDuplId:=false;
   WriteToEndFile(strochka);
  end;
 procedure TID.Obrab;
  var
   StringDigit,Strochka:string;
  begin
   new(PNextStackDat);
   PNextStackDat^.Name:=BuffString;
   PNextStackDat^.Link:=nil;
   if not FlagStackOpen then
    begin
     PointerStackDat:=PNextStackDat;
     StackDat:=PointerStackDat;
     FlagStackOpen:=true;
    end
    else
    begin
     PointerStackDat^.Link:=PNextStackDat;
     PointerStackDat:=PNextStackDat;
     PointerStackDat^.Link:=nil;
    end;
   strochka:='';
   str(PointerInStack,StringDigit);
   strochka:=strochka+BukvaKlassa+StringDigit;
   WriteToEndFile(strochka);
  end;
 procedure TRazd.ObrabRazd;
  var
   StringDigit,strochka:string;
  begin
   strochka:='';
   str(PointerInRazd,StringDigit);
   strochka:=strochka+BukvaKlassa+StringDigit;
   WriteToEndFile(strochka);
  end;
 procedure TSluSlo.Searc;
  var
   TimeStr:string[15];
   Simbl:char;
   k:integer;
   fl:boolean;
  begin
   WhereToWrite:=3;
   PointerInSluSlova:=0;
   TimeStr:='';
   for k:=1 to length(BuffString) do
    begin
     Simbl:=UpCase(BuffString[k]);
     TimeStr:=TimeStr+Simbl;
    end;
   k:=0;
   fl:=false;
   While (k <> NumberSluSlov) and (fl=false) do
    begin
     inc(k);
     if SluSlova[k]=TimeStr then {нащли в слу сло то что обрабатываем}
      begin
       WhereToWrite:=1;
       PointerInSluSlova:=k;
       fl:=true;
      end
    end;          {esli nichego ne nashli, to eto ID}
  end;
 procedure ToUp(var StrForUp:string);
  var
   k:byte;
   ASCIIcod:integer;
  begin
   for k:=1 to length(StrForUp) do
    begin
     ASCIIcod:=ord(StrForUp[k]);
     if (ASCIIcod>=97) and (ASCIIcod<=122) then
      begin
       ASCIIcod:=ASCIIcod-32;
       StrForUp[k]:=chr(ASCIIcod);
      end;
    end;
  end;
 procedure TID.Searc(WhereStackWrite:byte);
  var
   k:integer;
   fl:boolean;
   BuffMem:string;
   BuffMem1:string;
  begin
   WhereToWrite:=WhereStackWrite; {3}
   k:=0;
   fl:=false;
   PNextStackDat:=StackDat;
   While (PNextStackDat<>nil) and (not fl) do
    begin
     inc(k);
     if WhereStackWrite=3{стек идентификаторов}then
      begin
       BuffMem:=PNextStackDat^.Name;
       BuffMem1:=BuffString;
       ToUp(BuffMem);
       ToUp(BuffMem1);
       if BuffMem=BuffMem1 then
        begin
         WhereToWrite:=0;
         PointPresElem:=k;
         fl:=true;
        end;
      end
      else
       if PNextStackDat^.Name=BuffString then
        begin
         WhereToWrite:=0;
         PointPresElem:=k;
         fl:=true;
        end;
     PNextStackDat:=PNextStackDat^.Link;
    end;
   if WhereStackWrite=3{стек идентификаторов}then
    if (fl=false){не нашли в талице идентификаторов } and
    (OtklDuplID=false){находимся после begin} then
    Errora(15);  end;
 procedure TID.SearcElem(Number:byte;var data:string);
  var
   k:integer;
   fl:boolean;
  begin
   k:=0;
   fl:=false;
   PNextStackDat:=StackDat;
   While (PNextStackDat<>nil) and (not fl) do
    begin
     inc(k);
     if k=Number then
      begin
       data:=PNextStackDat^.name;
       fl:=true;
      end;
     PNextStackDat:=PNextStackDat^.Link;
    end;
  end;

 procedure TRazd.Searc;
  var
   k:integer;
   fl:boolean;
  begin
   WhereToWrite:=4;
   PointerInRazd:=0;
   k:=0;
   fl:=false;
   While (k <> NumberRazdel) and (fl=false) do
    begin
     inc(k);
     if Razdel[k]=BuffString then
      begin
       WhereToWrite:=0;
       PointerInRazd:=k;
       fl:=true;
      end
    end;
  end;
 procedure TLiter.RaspoznLiter;
  var
   j:byte;
   flag:boolean;
   Pamiat:integer;
  begin
   flag:=false;
   WhereToWrite:=5;
   Pamiat:=i; {Сохраняем индекс-указатель внутри раб строки}
   BuffString:=BuffString+WorkString[i];
   inc(i);
   while (i<=length(WorkString)) and (flag<>true) do
    if WorkString[i] <> #39 then
     begin
      BuffString:=BuffString+WorkString[i];
      inc(i);
     end
     else flag:=true;
   BuffString:=BuffString+WorkString[i];
   if flag=false then
    begin
     i:=Pamiat;
     {ProcError(3);{незакрытый литерал}
     Errora(9);
    end
    else
    begin
     if FlagStackOpen then Searc(5);{по BuffString либо 0 либо 5}
      if WhereToWrite = 5 then
       begin
        inc(PointerInStack);
        Str(PointerInStack,HelpStr);
        for j:=1 to 8-length(HelpStr) do
         HelpStr:=HelpStr+' ';
        HelpStr:=HelpStr+BuffString;
        Literal.Obrab;
       end
       else
       begin
        Str(PointPresElem,HelpStr);
        BuffString:=BukvaKlassa+HelpStr;
        WriteToEndFile(BuffString); {запись только в вых файл}
       end;
     end;
   HelpStr:='';
   BuffString:='';
  end;
 procedure RaspoznName;
  var
   j:byte;
   flag,ThisIsID:boolean;
  begin
   ThisIsID:=false;
   flag:=false;
   BuffString:=BuffString+WorkString[i];
   inc(i);
   while (i<=length(WorkString)) and (flag<>true) do
    begin
     if WorkString[i] in ['0'..'9'] then
      begin
       ThisIsID:=true;
       WhereToWrite:=3;
      end;
     if WorkString[i] in ['0'..'9','a'..'z','A'..'Z'] then
      begin
       BuffString:=BuffString+WorkString[i];
       inc(i);
      end
      else flag:=true;
    end;
    if length(BuffString)>8 then {длинное имя} Errora(10);
    dec(i);
    if not ThisIsID then SluSlo.Searc;
    if WhereToWrite=3 then {если идентификатор тогда}
     begin
      if ID.FlagStackOpen then ID.Searc(3);
   {} if WhereToWrite = 3 then
       begin
        inc(ID.PointerInStack);
        ID.Obrab   {We don't find this ID}
       end
       else
       begin   {WhereToWrite=0}
        if OtklDuplId then Errora(14);{если находимся до begin то при встрече}
                                      {при встрече повторного ид-ра - ошибка}
        BuffString:='';
        Str(ID.PointPresElem,HelpStr);
        BuffString:=ID.BukvaKlassa+HelpStr;
        WriteToEndFile(BuffString); {запись только в вых файл}
    {} end;
     end
      else SluSLo.ObrabSluSlo;
   HelpStr:='';
   BuffString:='';
  end;
 procedure TChisla.RaspoznChis;
  var
   j:byte;
   flag:boolean;
  begin
   WhereToWrite:=2;
   flag:=false;
   BuffString:=BuffString+WorkString[i];
   while (i<=length(WorkString)) and (flag<>true) do
    begin
     inc(i);
     if WorkString[i] in ['0'..'9'] then
     BuffString:=BuffString+WorkString[i] else
     begin
      dec(i);
      flag:=true;
      if FlagStackOpen then Searc(2);{по BuffString либо 0 либо 2}
      if WhereToWrite = 2 then
       begin
        inc(Chisla.PointerInStack);
        Chisla.Obrab {ne nashli}
       end
       else
       begin
        Str(PointPresElem,HelpStr);
        BuffString:=BukvaKlassa+HelpStr;
        WriteToEndFile(BuffString); {запись только в вых файл}
       end;
     end
    end;
   HelpStr:='';
   BuffString:='';
  end;
 procedure TRazd.RaspoznRazd;
  var
   j:byte;
   flag,fl:boolean;
   pamiat:integer;
  begin
   WhereToWrite:=4;
   flag:=false;
   fl:=false;
   if WorkString[i] = '/'then
    begin
     inc(i);
     fl:=true; {uvelichivali li mi i}
    end;
   if (WorkString[i-1] ='/') and (WorkString[i] ='*') then
      begin
       pamiat:=i;
       inc(i);
       repeat
       inc(i);
       if (WorkString[i-1] = '*')and (WorkString[i] ='/') then
        flag:=true;
       until ((WorkString[i-1] = '*')and (WorkString[i] ='/')) or
       (i>length(WorkString));
       if not flag then
        begin
         i:=pamiat;
         Errora(11);
        end
      end
     else
      begin
       if fl then dec(i);
       BuffString:=BuffString+WorkString[i];
       Searc;{по BuffString либо 0 либо 4}
       if WhereToWrite = 4 then{razdelitel not found, pop-ka dopisi}
         Errora(12)
       else Razd.ObrabRazd;
      end;
   HelpStr:='';
   BuffString:='';
  end;
 procedure Initial;
  begin
   SluSlo.Init;
   Chisla.Init;
   ID.Init;
   Razd.Init;
   Literal.Init;
   ClrScr;
   WorkString:=''; {строка,которую обраб}
   BuffString:=''; {строка,куда вырезаем}
   WhereToWrite:=0;
   FileErrorOpen:=false;
   FlagFileEndOpen:=false;
   NumberOfWorkStr:=0;{номер обраб строки}
   HelpStr:='';
   SchechikStrok:=1;
   OtklDuplId:=true;
   MetkaIf:=0;
   MetkaFor:=0;
   MetDel:=0;
   MetToDec:=0;
   UkToT:=0;       {RN =true,когда обрабатывалось I11,S34..., т.e.}
   ReadNot:=false; {после буквы класса было две цифры}
   Ukaz:=1; {указатель внутри выходной строки}
   MetkaRead:=0;
   MetkaF:=0;
   KolRekurs:=0;
   KolRekursF:=0;
   FlagObrLength:=false;{Когда обрабатываем LENGTH - true}
   FlagObrE:=false;
   DoCallDel:=false;
   MetkaDel:=0;
   DoCallCopy:=false;
   MetkaInsert:=0;
   DoCallIns:=false;
   DoCallClear:=false;
   Vozvr:=false;
   IIFF:=false;
   DoCallPress:=false;
  end;
 procedure LexicAnalis;
  begin
  While not eof(Var_File) do
   begin
    inc(NumberOfWorkStr);
    ReadLn(Var_File,WorkString);
    if WorkString<>'' then
     begin
      for i:=1 to length(WorkString) do
       if (WorkString[i]<>' ') and (WorkString[i]<>#13)
        and (WorkString[i]<>#9) then
        if WorkString[i] in ['a'..'z','A'..'Z','0'..'9',#39] then
        case WorkString[i] of
         'a'..'z','A'..'Z'                    : RaspoznName;
         '0'..'9'                             : Chisla.RaspoznChis;
         #39 {'}                              : Literal.RaspoznLiter;
        end
        else Razd.RaspoznRazd;
     end;
    WriteToEndFile('#');
   end;
  end;
  begin
  end.